;;************************************************************************
;; scatmat.lsp 
;; contains code for new and revised methods for scatterplot-matrix
;; and for scatterplot-matrix2, which uses containers and scatterplots.
;; copyright (c) 1991-98 by Forrest W. Young
;;************************************************************************

(defun scatmat (&rest args)
"Produces scatterplot-matrix with ViSta look and feel. Same args as scatterplot-matrix"
     (let ((plot (apply #'scatterplot-matrix args))
           )
       (send plot :use-color t)
       (send plot :plot-buttons :new-x nil :new-y nil :free nil)
       (send plot :point-color (iseq (send plot :num-points)) 'blue)
       (send plot :mouse-mode 'brushing)
       plot))

(defmeth scatmat-proto :menu-template (&optional (values nil set))
  '(help dash print save copy))


#|
(defmeth scatmat-proto :popup-menu-template ()
  '(showing-labels mouse resize-brush dash
    erase-selection focus-on-selection view-selection dash select-all show-all dash
    symbol color))
|#

(defmeth scatmat-proto :do-new-variable-focus (x y m1 m2)
"Used by new spreadplots. Method to focus on variable subplots. Assumes that spreadplot object exists. A click on a diagonal cell selects one variable. A click on a subplot selects two variables. Shift-clicks select multiple variables."
  (when (not (send self :has-slot 'spin-var))
        (send self :add-slot 'spin-var)
        (defmeth self :spin-var (&optional (var-list nil set))
          (if set (setf (slot-value 'spin-var) var-list))
          (slot-value 'spin-var)))
  (let* ((cur-var (send self :current-variables))
         (spin-var (send self :spin-var))
         (nvar (send self :num-variables))
         (var-labs (send self :variable-label cur-var))
         (obs-nums (iseq (send self :num-points)))
         (cur-data  
          (mapcar #'(lambda (x) 
                      (send self :point-coordinate x obs-nums)) cur-var))
         (sp (send self :spreadplot-object))
         )
    (when (not m1)
          (setf spin-var cur-var)
          (send sp :update-spreadplot 
                0 0 
                spin-var
                (list var-labs cur-data))
          )
    (when m1
          (if (not spin-var) (setf spin-var cur-var))
          (setf cur-var (remove-duplicates cur-var))
          (setf spin-var (combine (adjoin spin-var cur-var)))
          (setf spin-var (remove-duplicates spin-var))
          (setf var-labs (send self :variable-label spin-var))
          (setf cur-data  
                (mapcar #' (lambda (x) 
                   (send self :point-coordinate x obs-nums)) spin-var))
          (send sp :update-spreadplot 
                0 0 
                spin-var
                (list var-labs cur-data)))
    (send self :spin-var spin-var)
    ))

(defmeth scatmat-proto :do-variable-focus (x y m1 m2)
"Used by old spreadplots. Method to focus on variable subplots. Assumes that three other plots exist.  These plots MUST be named scatterplot, spin-plot and histogram.  A click on a subplot sends it to scatterplot and sends its horizontal variable to histogram.  A click on a diagonal cell sends that variable to histogram.  Shift-clicks send first three selected variables to spin-plot as well."
  (let ((cur-var (send self :current-variables))
        (nvar (send self :num-variables))
        (scale-type (send scatterplot :scale-type)))
    (when (not m1)
          (when (/= (select cur-var 0) (select cur-var 1))
                (send scatterplot :current-variables 
                      (select cur-var 0) (select cur-var 1) :draw nil)
                (if scale-type 
                    (send scatterplot :redraw)
                    (send scatterplot :adjust-to-data)))
          (send histogram :current-variables 
                (select cur-var 0) nvar :draw nil) 
          (send histogram   :adjust-to-data)
          (setf spin-var ()))
    (when m1
          (when (= (select cur-var 0) (select cur-var 1))
                (setf cur-var (list (select cur-var 0))))
          (when (< (length spin-var) 3)
                (setf spin-var (adjoin (select cur-var 0) spin-var))
                (when (< (length spin-var) 3)
                      (if (equal (length cur-var) 2)
                          (setf spin-var 
                                (adjoin (select cur-var 1) spin-var)))))
          (when (= (length spin-var) 3)
                (setf spin-var (reverse spin-var))
                (send spin-plot 
                      :current-variables (select spin-var 0)
                      (select spin-var 1) (select spin-var 2)
                      :draw nil)
                (send scatterplot :current-variables 
                      (select spin-var 0) (select spin-var 1) :draw nil)
                (send histogram :current-variables 
                      (select spin-var 0) nvar :draw nil) 
                (let ((cur-var (send spin-plot :current-variables)))
                  (send spin-plot :set-variables-with-labels cur-var
                        (select (send spin-plot :variable-labels) cur-var))
                  (send spin-plot :redraw))
                (if scale-type 
                    (send scatterplot :redraw)
                    (send scatterplot :adjust-to-data))
                (send histogram   :adjust-to-data)
                (setf spin-var ())))))

(defun scatterplot-matrix2 (numeric-matrix &key (type 1))
"Creates a scatterplot-matrix using a spreadplot. The required argument is a matrix of numeric values. An optional keyword argument is TYPE (0 for no lines between cells; 1, the default, for simple lines, 2 for raised and 3 for sunken lines)."
  (setf *spreadplot-container* (make-container :free t :local-menus t :type type :show nil))
  (let* ((raw-vars (column-list numeric-matrix))
         (nvar (length raw-vars))
         (plots)
         (plot-matrix)
         (sp))
    (dotimes (i nvar)
             (dotimes (j nvar)
                      (cond 
                        ((> i j)
                         (setf pp (plot-points (list (select raw-vars i)
                                                     (select raw-vars j))
                                               :show t)))
                        ((= i j)
                         (setf pp (qplot (select raw-vars i)
                                         :show t)))
                        ((< i j)
                         (setf pp (plot-points (list (select raw-vars i)
                                                     (select raw-vars j))
                                               :show t))))
                      (send pp :showing-labels nil)
                      (send pp :use-color t)
                      (send pp :point-color (iseq (send pp :num-points)) 'blue)
                      (send pp :mouse-mode 'selecting)
                      (send pp :x-axis nil)
                      (send pp :y-axis nil)
                      (send pp :legend1 " ")
                      (send pp :legend2 " ")
                      (setf plots (append plots (list pp))))
             )
    (setf matrix-plots (matrix (list nvar nvar) (combine plots)))
    (setf matrix-plots (combine (mapcar 'reverse (column-list matrix-plots))))
    (setf sp (spread-plot (matrix (list nvar nvar) matrix-plots)
                          :rel-widths (repeat 1.5 nvar)))
    (mapcar #'(lambda (plot) (when plot (send plot :linked t))) plots)
    (send sp :show-spreadplot)
    (send *spreadplot-container* :show-window) 
    (refresh-spreadplot)
    (disable-container)))

:modifications by PV 10-4-2003


(defmeth scatmat-proto :focus-on-selection ()
  (call-next-method)
  (send self :adjust-to-data))
(defmeth scatmat-proto :erase-selection ()
  (call-next-method)
  (send self :adjust-to-data))
(defmeth scatmat-proto :show-all-points ()
  (call-next-method)
  (send self :adjust-to-data))